#!/usr/local/bin/perl
#
# Copyright 1993 University of Minnesota
#
# A simple Perl script that makes up part of a gopher+
# conferencing system/method that allows users to
# dynamically grow a section of gopherspace. This is
# done by taking advantage of gopher+ ask blocks.
#
# this section is used to create a new collection 
# (a new gopher directory) an copy the dynamic burrowing
# tools into the new collection
#
#	Mark P. McCahill
#	March 1993

$Insecure=<>;

#  make insecure input secure

$Insecure =~ m/^(.*)$/;
$DirName = $1;  #dirname is now secure


# replace all the naughty characters with a single space
$DirName =~ tr/0-9a-zA-Z/ /cs;


#make sure that the name doesn't start with a blank
$DirName =~ s/^\s+//;

if ( length( $DirName ) < 1 ) {
	$DirName = "untitled";
}

if ( length( $DirName ) > 60 ) {
	$DirName = substr($DirName,0,59);
}


if ( opendir($dhdl, $DirName) ) {
	print "Could not create the directory you requested\n";
	print "because $DirName already exists.\n";
}
else {
	print( "Creating a new collection...\n" );
	# create the directory with a copy of the burrowing tools 
	if ( mkdir( $DirName, 493 ) ) {

		&CloneFile( "/Add_an_item_to_this_collection" );
		&CloneFile( "/Chat_on_CB_radio" );
		&CloneFile( "/Create_a_new_collection" );

		print "A new gopher collection called \n";
		print "     $DirName\n";
		print "has been created.\n\n";
		print "You can now open the collection and\n";
		print "and add information to it.\n";
	} 
	else {
		print "$! \n";
		print "Sorry, couldn't create collection named $DirName\n";
	}
}
unlink ".cache";
unlink ".cache+";


sub CloneFile {
        ($PartName) = @_;
        $FileName =  $DirName . $PartName;
        open(outhdl, ">$FileName");
        open(inhdl, "<./$PartName" );
        while ( $buffer = <inhdl> ) {
                print(outhdl $buffer );
        }
        # set the execute flag on the script
        chmod 0755, $FileName;
        close outhdl;
        close inhdl;
        $FileName = $FileName . ".ask";
        $PartName = $PartName . ".ask";
        open(outhdl, ">$FileName");
        open(inhdl, "<./$PartName");
        while ( $buffer = <inhdl> ) {
                print(outhdl $buffer );
        }
        close outhdl;
        close inhdl;
};

